home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / UABORT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  3.9 KB  |  160 lines
  1. { uabort.pas -- Printer support unit with abort dialog }
  2.  
  3. unit UAbort;
  4.  
  5. interface
  6.  
  7. {$R uabort.res}
  8.  
  9. uses WinTypes, WinProcs, WObjects, Strings;
  10.  
  11. const
  12.  
  13.   abortID = 'ABORTDIAG';   { Dialog resource ID }
  14.  
  15. type
  16.  
  17.   PAbort = ^TAbort;
  18.   TAbort = object(TDlgWindow)
  19.     procedure WMInitDialog(var Msg: TMessage);
  20.       virtual wm_First + wm_InitDialog;
  21.     procedure WMCommand(var Msg: TMessage);
  22.       virtual wm_First + wm_Command;
  23.   end;
  24.  
  25. var
  26.  
  27.   PDc: HDC;                 { Printer's DC: valid if PrnStart = true }
  28.   Printing: Boolean;        { True after successful call to PrnStart }
  29.   EscResult: Integer;       { Result of most recent call to Escape }
  30.   Aborted: Bool;            { True if Cancel button selected }
  31.  
  32.  
  33. function NextToken(P: PChar; C: Char): PChar;
  34. function PrnStart(DocumentName: PChar): Boolean;
  35. procedure NewPage;
  36. procedure PrnStop;
  37.  
  38.  
  39. implementation
  40.  
  41. var
  42.  
  43.   AbortDiag: PAbort;        { Pointer to abort dialog object }
  44.   HAbortDiag: HWnd;         { Handle to modeless abort dialog }
  45.   PAbortProc: TFarProc;     { Pointer to abort callback function }
  46.  
  47.  
  48. {- Return pointer to next token in P or previous P if P = nil }
  49. function NextToken(P: PChar; C: Char): PChar;
  50. const
  51.   Next: PChar = nil;
  52. begin
  53.   if P = nil then P := Next;
  54.   Next := StrScan(P, C);
  55.   if Next <> nil then
  56.   begin
  57.     Next^ := #0;
  58.     Next := @Next[1]
  59.   end;
  60.   NextToken := P
  61. end;
  62.  
  63. {- Abort callback function }
  64. function AbortProc(PDc: HDC; Code: Integer): Bool; export;
  65. var
  66.   Msg: TMsg;
  67. begin
  68.   while (not Aborted) and PeekMessage(Msg, 0, 0, 0, pm_Remove) do
  69.     if (HAbortDiag = 0) or not IsDialogMessage(HAbortDiag, Msg) then
  70.     begin
  71.       TranslateMessage(Msg);
  72.       DispatchMessage(Msg)
  73.     end;
  74.   AbortProc := not Aborted
  75. end;
  76.  
  77. {- If true, printing has been initialized }
  78. function PrnStart(DocumentName: PChar): Boolean;
  79. var
  80.   Buffer: array[0 .. 80] of Char;
  81.   DriverName, DeviceName, OutputName: PChar;
  82. begin
  83.   GetProfileString('windows', 'device', ',,', Buffer, Sizeof(Buffer));
  84.   DeviceName := NextToken(Buffer, ',');
  85.   DriverName := NextToken(nil, ',');
  86.   OutputName := NextToken(nil, ',');
  87.   Aborted := false;
  88.   PDc := CreateDC(DriverName, DeviceName, OutputName, nil);
  89.   if PDc <> 0 then
  90.   begin
  91.     AbortDiag := PAbort(Application^.MakeWindow(
  92.       New(PAbort, Init(Application^.MainWindow, abortID))));
  93.     if AbortDiag = nil then
  94.     begin
  95.       Application^.Error(em_OutOfMemory);
  96.       Printing := false
  97.     end else
  98.     begin
  99.       HAbortDiag := AbortDiag^.HWindow;
  100.       PAbortProc := MakeProcInstance(@AbortProc, HInstance);
  101.       EscResult := Escape(PDc, SetAbortProc, 0, PAbortProc, nil);
  102.       if EscResult >= 0 then
  103.         EscResult := Escape(PDc, StartDoc, StrLen(DocumentName),
  104.           DocumentName, nil);
  105.       Printing := EscResult > 0
  106.     end
  107.   end;
  108.   if not Printing then
  109.   begin
  110.     if AbortDiag <> nil then
  111.       AbortDiag^.CloseWindow;
  112.     MessageBox(Application^.MainWindow^.HWindow,
  113.       'Printer initialization failed', 'Error',
  114.       mb_IconExclamation or mb_Ok)
  115.   end;
  116.   PrnStart := Printing
  117. end;
  118.  
  119. {- Print current page and start a new one }
  120. procedure NewPage;
  121. begin
  122.   if Printing and (EscResult > 0) then
  123.     EscResult := Escape(PDc, NewFrame, 0, nil, nil)
  124. end;
  125.  
  126. {- Call only if PrnStop returned true. }
  127. procedure PrnStop;
  128. begin
  129.   if Printing then
  130.   begin
  131.     if EscResult > 0 then
  132.       Escape(PDc, EndDoc, 0, nil, nil);
  133.     if AbortDiag <> nil then
  134.       AbortDiag^.CloseWindow;
  135.     DeleteDC(PDc);
  136.     Printing := false
  137.   end
  138. end;
  139.  
  140.  
  141. { TAbort }
  142.  
  143. procedure TAbort.WMInitDialog(var Msg: TMessage);
  144. begin
  145.   SetFocus(HWindow)
  146. end;
  147.  
  148. procedure TAbort.WMCommand(var Msg: TMessage);
  149. begin
  150.   Aborted := true
  151. end;
  152.  
  153. end.
  154.  
  155.  
  156. {--------------------------------------------------------------
  157.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  158.   Revision 1.00    Date: 5/19/1991
  159. ---------------------------------------------------------------}
  160.